home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / Pascal / Snippets / 3DBouncer / CheapSound2.p < prev   
Encoding:
Text File  |  1995-11-18  |  3.6 KB  |  135 lines  |  [TEXT/PJMM]
  1. {CheapSound2: was once a minimal sound playing unit, but is here expanded to}
  2. {do stereo panning too. Made by Ingemar Ragnemalm 1995.}
  3.  
  4. {Notes on performance:}
  5. {The sound playing can be made much faster by not disposing and re-allocating the}
  6. {channels all the time, but rather flushing them. Also, the sounds could be permanently}
  7. {accessed through locked handles, not by GetResource calls. Multi-channel sound isn't}
  8. {in here either, and is really easy: just add more channels.}
  9. {All that can be fixed, but this is made to be small and safe.}
  10.  
  11. unit CheapSound2;
  12. interface
  13.     uses
  14. {$IFC UNDEFINED THINK_PASCAL}
  15.         Types, Memory, Packages, Quickdraw, ToolUtils, GestaltEqu, Resources, 
  16. {$ENDC}
  17.         Sound;
  18.     procedure TerminateSound;
  19.     procedure PlaySound (mySndID: Integer; h, v: Integer);
  20.     procedure PlayNamedSound (name: Str255; h, v: Integer);
  21.  
  22. implementation
  23.  
  24.     var
  25.         mySndChan: SndChannelPtr;
  26.         initialized: Boolean;
  27.         hasSound: Boolean;
  28.         hasStereo: Boolean;
  29.         hasSoundMgr3: Boolean;
  30.  
  31. {If you have Universal Interfaces for Think Pascal, you may have to comment out this:}
  32. {$IFC UNDEFINED THINK_PASCAL}
  33. {$ELSEC}
  34.     type
  35.         SndListHandle = Handle;
  36. {$ENDC}
  37.  
  38.     const
  39.         kAsync = true;
  40.         volumeCmd = 46;
  41.  
  42.     procedure InitCheapSound;
  43.         var
  44.             err: OSErr;
  45.             response: Longint;
  46.     begin
  47.         initialized := true;
  48. {Is sound mgr around at all? Tested through the system version.}
  49.         err := Gestalt(gestaltSystemVersion, response);
  50.         if err = noErr then
  51.             hasSound := response >= $602;
  52.         if hasSound then
  53.             begin
  54. {Do we have stereo?}
  55.                 err := Gestalt(gestaltSoundAttr, response);
  56.                 if err = noErr then
  57.                     hasStereo := BitAnd(response, BSL(1, gestaltStereoCapability)) <> 0;
  58. {Do we have modern sound mgr?}
  59.                 hasSoundMgr3 := SndSoundManagerVersion.majorRev >= 3;
  60.             end;
  61.     end; {InitCheapSound}
  62.  
  63.     procedure TerminateSound;
  64.         var
  65.             myErr: OSErr;
  66.     begin
  67.         if not initialized then
  68.             InitCheapSound;
  69.         if not hasSound then
  70.             Exit(TerminateSound);
  71.  
  72.         if mySndChan <> nil then
  73.             myErr := SndDisposeChannel(mySndChan, TRUE);
  74.         mySndChan := nil;
  75.     end; {TerminateSound}
  76.  
  77.     procedure PlaySoundHandle (mySndHandle: Handle; h, v: Integer);
  78.         var
  79.             myErr: OSErr;
  80.             pos: Point;
  81.             theCmd: SndCommand;
  82.     begin
  83.         TerminateSound;
  84.         if mySndHandle = nil then
  85.             Exit(PlaySoundHandle);
  86.         if not hasSound then
  87.             Exit(PlaySoundHandle);
  88.  
  89.         mySndChan := nil;
  90.  
  91. {If stereo isn't available or stereo panning is possible, initialize standard (0),}
  92. {else initialize either right or left as appropriate.}
  93.         if (hasStereo and hasSoundMgr3) or not hasStereo or (Abs(h - v) < 100) then
  94.             myErr := SndNewChannel(mySndChan, sampledSynth, 0, nil)
  95.         else if h > v then
  96.             myErr := SndNewChannel(mySndChan, sampledSynth, initChanRight, nil)
  97.         else
  98.             myErr := SndNewChannel(mySndChan, sampledSynth, initChanLeft, nil);
  99.  
  100.         if hasStereo and hasSoundMgr3 then
  101.             begin
  102.                 theCmd.cmd := volumeCmd;
  103.                 theCmd.param1 := 0;
  104.                 pos.h := h;
  105.                 pos.v := v;
  106.                 theCmd.param2 := Longint(pos);
  107.                 myErr := SndDoImmediate(mySndChan, theCmd);
  108.             end;
  109.  
  110.         myErr := SndPlay(mySndChan, SndListHandle(mySndHandle), kAsync);
  111.     end; {PlaySoundHandle}
  112.  
  113.     procedure PlaySound (mySndID: Integer; h, v: Integer);
  114.         var
  115.             mySndHandle: Handle;
  116.     begin
  117.         mySndHandle := GetResource('snd ', mySndID);
  118.         if mySndHandle = nil then
  119.             Exit(PlaySound);
  120.         HLock(mySndHandle);
  121.         PlaySoundHandle(mySndHandle, h, v);
  122.     end; {PlaySound}
  123.  
  124.     procedure PlayNamedSound (name: Str255; h, v: Integer);
  125.         var
  126.             mySndHandle: Handle;
  127.     begin
  128.         mySndHandle := GetNamedResource('snd ', name);
  129.         if mySndHandle = nil then
  130.             Exit(PlayNamedSound);
  131.         HLock(mySndHandle);
  132.         PlaySoundHandle(mySndHandle, h, v);
  133.     end; {PlayNamedSound}
  134.  
  135. end.